Multimedia Jumpstart/Multimedia Microsoft Jumpstart Version 1.1a (Microsoft).BIN/develpmt/source/vbsprsrc/sprdemo.frm

Visual Basic Form | 1994-02-15 | 7.4 KB | 203 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Form1"
   ClientHeight    =   3672
   ClientLeft      =   876
   ClientTop       =   1524
   ClientWidth     =   6084
   Height          =   4092
   Left            =   828
   LinkTopic       =   "Form1"
   ScaleHeight     =   306
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   507
   Top             =   1152
   Width           =   6180
   Begin Timer Timer1
      Interval        =   1
      Left            =   360
      Top             =   240
   End
Option Explicit
' interface to sprite DLL
const UPDATE_SCREEN = 1
const NO_UPDATE = 0
Declare Function CreateSpriteWindow Lib "VBSPRITE.DLL" (ByVal hWnd As Integer) As Long
Declare Sub DeleteSpriteWindow Lib "VBSPRITE.DLL" (ByVal pSpriteWnd As Long)
Declare Function LoadDIB Lib "VBSPRITE.DLL" (ByVal filename As String) As Long
Declare Sub DeleteDIB Lib "VBSPRITE.DLL" (ByVal pDIB As Long)
Declare Sub SetBackground Lib "VBSPRITE.DLL" (ByVal pSpriteWnd As Long, ByVal pDIB As Long, ByVal bUpdate As Integer)
Declare Function CreateSprite Lib "VBSPRITE.DLL" (ByVal pSpriteWnd As Long, ByVal pSprDib As Long, ByVal initx As Integer, ByVal inity As Integer, ByVal initz As Integer, ByVal bRedraw As Integer) As Long
Declare Sub DeleteSprite Lib "VBSPRITE.DLL" (ByVal pSpriteWnd As Long, ByVal pSprite As Long)
Declare Function SpriteHitTest Lib "VBSPRITE.DLL" (ByVal pSpriteWnd As Long, ByVal x As Integer, ByVal y As Integer) As Long
Declare Sub SetSpritePosition Lib "VBSPRITE.DLL" (ByVal pSpriteWnd As Long, ByVal pSprite As Long, ByVal x As Integer, ByVal y As Integer, ByVal bUpdate As Integer)
Declare Sub SetSpriteZOrder Lib "VBSPRITE.DLL" (ByVal pSpriteWnd As Long, ByVal pSprite As Long, ByVal z As Integer, ByVal bUpdate As Integer)
Declare Sub SetSpriteDIB Lib "VBSPRITE.DLL" (ByVal pSpriteWnd As Long, ByVal pSprite As Long, ByVal pSprDib As Long, ByVal bUpdate As Integer)
Declare Function GetDIBWidth Lib "VBSPRITE.DLL" (ByVal pDIB As Long) As Long
Declare Function GetDIBHeight Lib "VBSPRITE.DLL" (ByVal pDIB As Long) As Long
Declare Sub RepaintSpriteWindow Lib "VBSPRITE.DLL" (ByVal pSpriteWnd As Long)
Declare Sub SetSpriteVisible Lib "VBSPRITE.DLL" (ByVal pSpriteWnd As Long, ByVal pSprite As Long, ByVal bVisible As Integer, ByVal bUpdate As Integer)
    ' pointers to sprites 'n' stuff
    Dim pSpriteWnd As Long
    Dim pBkDib As Long
    Dim pNellDib As Long
    Dim pOliviaDib As Long
    Dim pSunDib As Long
    Dim pMoonDib As Long
    Dim pDuckDib1 As Long
    Dim pDuckDib2 As Long
    Dim pDuckDib3 As Long
    Dim pDuckDib4 As Long
    Dim pSprite1 As Long
    Dim pSprite2 As Long
    Dim pSprite3 As Long
    Dim pCurrentSprite As Long
Dim bMouseDown As Integer
Dim bSpriteImage As Integer
Dim nDuckImage As Integer
Dim lTime As Long
Dim maxx As Integer' size of background
Dim maxy As Integer
Dim sp1x As Integer' sprite 1 (sun/moon) vars
Dim sp1y As Integer
Dim sp1vx As Integer
Dim sp1vy As Integer
Dim sp1ay As Integer
Dim sp1w As Integer
Dim sp1h As Integer
Dim sp2x As Integer' sprite 2 (ducks) vars
Dim sp2y As Integer
Dim sp2vx As Integer
Dim sp2vy As Integer
Dim sp2ay As Integer
Dim sp2w As Integer
Dim sp2h As Integer
Dim sp3x As Integer ' sprite 3 (nell) vars
Dim sp3y As Integer
Dim MouseDiffX As Integer ' for dragging sprites
Dim MouseDiffY As Integer
Sub Form_Load ()
    form1.Visible = True
    pSpriteWnd = CreateSpriteWindow(form1.hWnd)
    pBkDib = LoadDIB("bkgnd.dib")
    SetBackground pSpriteWnd, pBkDib, UPDATE_SCREEN
    pNellDib = LoadDIB("nell.dib")
    pOliviaDib = LoadDIB("olivia.dib")
    pSunDib = LoadDIB("sun.dib")
    pMoonDib = LoadDIB("moon.dib")
    pDuckDib1 = LoadDIB("duck1.dib")
    pDuckDib2 = LoadDIB("duck2.dib")
    pDuckDib3 = LoadDIB("duck3.dib")
    pDuckDib4 = LoadDIB("duck4.dib")
    pSprite1 = CreateSprite(pSpriteWnd, pSunDib, 20, 20, 50, UPDATE_SCREEN)
    pSprite2 = CreateSprite(pSpriteWnd, pDuckDib1, 20, 20, 20, UPDATE_SCREEN)
    pSprite3 = CreateSprite(pSpriteWnd, pNellDib, 20, 20, 30, UPDATE_SCREEN)
    maxx = GetDIBWidth(pBkDib)
    maxy = GetDIBHeight(pBkDib)
    sp1x = 20 ' initialize sun/moon
    sp1y = 20
    sp1vx = 5
    sp1vy = 25
    sp1ay = 1
    sp2x = 20 ' initialize duck
    sp2y = 20
    sp2vx = 40
    sp2vy = 0
    sp2ay = 0
    sp2w = GetDIBWidth(pDuckDib1)
    sp3x = 20
    sp3y = 20
End Sub
Sub Form_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
bMouseDown = 1
pCurrentSprite = SpriteHitTest(pSpriteWnd, x, y)
If (pCurrentSprite = pSprite3) Then
    MouseDiffX = x - sp3x
    MouseDiffY = y - sp3y
End If
If (pCurrentSprite = pSprite2) Then
    sp2vx = 0
    sp2vy = 0
    sp2ay = 3
End If
If (pCurrentSprite = pSprite1) Then
    sp1vy = sp1vy - 20
End If
End Sub
Sub Form_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
    If (bMouseDown And pCurrentSprite = pSprite3) Then
        SetSpritePosition pSpriteWnd, pSprite3, x - MouseDiffX, y - MouseDiffY, UPDATE_SCREEN
    End If
End Sub
Sub Form_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
bMouseDown = 0
If (pCurrentSprite = pSprite3) Then
    sp3x = x - MouseDiffX
    sp3y = y - MouseDiffY
End If
End Sub
Sub Form_Paint ()
    If (pSpriteWnd) Then RepaintSpriteWindow pSpriteWnd
End Sub
Sub Form_Unload (Cancel As Integer)
    DeleteSprite pSpriteWnd, pSprite1
    DeleteSprite pSpriteWnd, pSprite2
    DeleteSprite pSpriteWnd, pSprite3
    DeleteSpriteWindow pSpriteWnd
    pSpriteWnd = 0 ' stop repaints!
    DeleteDIB pOliviaDib
    DeleteDIB pNellDib
    DeleteDIB pSunDib
    DeleteDIB pMoonDib
    DeleteDIB pBkDib
End Sub
Sub Timer1_Timer ()
lTime = lTime + 1
nDuckImage = nDuckImage + 1
' rotate duck image, but wait until the duck is moved before it's redrawn
If (nDuckImage > 3) Then nDuckImage = 0
Select Case nDuckImage
    Case 0
        SetSpriteDIB pSpriteWnd, pSprite2, pDuckDib1, NO_UPDATE
    Case 1
        SetSpriteDIB pSpriteWnd, pSprite2, pDuckDib2, NO_UPDATE
    Case 2
        SetSpriteDIB pSpriteWnd, pSprite2, pDuckDib3, NO_UPDATE
    Case 3
        SetSpriteDIB pSpriteWnd, pSprite2, pDuckDib4, NO_UPDATE
End Select
' move sun/moon
sp1x = sp1x + sp1vx
sp1y = sp1y + sp1vy
sp1vy = sp1vy + sp1ay
If sp1x < 0 And sp1vx < 0 Then sp1vx = -sp1vx
If sp1y < 0 And sp1vy < 0 Then sp1vy = -sp1vy
If sp1x + sp1w > maxx And sp1vx > 0 Then sp1vx = -sp1vx
If sp1y + sp1h > maxy And sp1vy > 0 Then sp1vy = -sp1vy * .9
SetSpritePosition pSpriteWnd, pSprite1, sp1x, sp1y, UPDATE_SCREEN
'move duck
sp2x = sp2x + sp2vx
sp2y = sp2y + sp2vy
sp2vy = sp2vy + sp2ay
If sp2x < 0 And sp2vx < 0 Then sp2vx = -sp2vx
If sp2y < 0 And sp2vy < 0 Then sp2vy = -sp2vy
If sp2x + sp2w > maxx And sp2vx > 0 Then sp2vx = -sp2vx
If sp2y + sp2h > maxy And sp2vy > 0 Then sp2vy = -sp2vy * .7
SetSpritePosition pSpriteWnd, pSprite2, sp2x, sp2y, UPDATE_SCREEN
' periodically change sun into moon.
If (lTime > 25) Then
    If (bSpriteImage) Then
        SetSpriteDIB pSpriteWnd, pSprite1, pSunDib, UPDATE_SCREEN
        sp1w = GetDIBWidth(pSunDib) ' get new size so we bounce properly
        sp1h = GetDIBHeight(pSunDib)
        bSpriteImage = False
    Else
        SetSpriteDIB pSpriteWnd, pSprite1, pMoonDib, UPDATE_SCREEN
        sp1w = GetDIBWidth(pMoonDib)
        sp1h = GetDIBHeight(pMoonDib)
        bSpriteImage = True
    End If
    lTime = 0
End If
End Sub